Attribute VB_Name = "mdlCalculator"
Option Explicit

Public Enum enuReturns
    lpSucceed = 0
    lpSyntaxError = 1
    lpRunError = 2
End Enum

Public Enum enuDebugger
    lpNull = 0
    lpInput = 1
End Enum

Public lpLogBase As Double
Public bpRadianWay As Boolean
Public bpIsMeanXor As Boolean

Public Sub IntialConstants(Optional ByVal lpLogBS As Double = 10, Optional ByVal isMeanXor As Boolean = False)
    On Error Resume Next
    lpLogBase = lpLogBS
    bpIsMeanXor = isMeanXor
End Sub

Public Function GetRoot(ByVal lpNumber As Double, ByVal lpRootLevel As Double) As Double
    On Error Resume Next
    GetRoot = lpNumber ^ (1 / lpRootLevel)
End Function

Public Sub DebuggerSection(ByVal strInput As String, ByVal enDbgFlags As enuDebugger, Optional ByVal lpLevel As Long = 1)
    On Error Resume Next
    Select Case enDbgFlags
        Case lpNull
            Debug.Print "Null(Level " & Trim(Str(lpLevel)) & ") - at " & Trim(Str(Timer))
        Case lpInput
            Debug.Print "Input Task(Level " & Trim(Str(lpLevel)) & ") - " & strInput & " at " & Trim(Str(Timer))
    End Select
End Sub

Public Function ScanSuffixLetter(ByVal strInput As String, ByVal lpStart As Long, ByRef lpEnd As Long) As String
    On Error Resume Next
    Dim lpCurrent As Long
    Dim strIS As String
    Dim lpSelected As Long
    Const strSignature = "+-*/\^()<>=&|!"
    lpSelected = Len(strInput)
    For lpCurrent = lpStart To Len(strInput)
        strIS = Mid(strInput, lpCurrent, 1)
        If InStr(1, strSignature, strIS) <> 0 Then
            lpSelected = lpCurrent - 1
            Exit For
        End If
        DoEvents
    Next lpCurrent
    lpEnd = lpSelected
    ScanSuffixLetter = Left(strInput, lpSelected)
End Function

Public Function ScanPrefixNumber(ByVal strInput As String, ByRef strVariant As String) As String
    On Error Resume Next
    Dim lpCurrent As Long
    Dim lpPosition As Long
    Dim strPrefix As String
    Dim strMiddle As String
    For lpCurrent = Len(strInput) To 1 Step -1
        strPrefix = Left(strInput, lpCurrent)
        If IsNumeric(strPrefix) = True Then
            strVariant = Right(strInput, Len(strInput) - lpCurrent)
            strMiddle = strPrefix
            Exit For
        End If
        DoEvents
    Next lpCurrent
    If Trim(strVariant) = vbNullString Then
        strVariant = strInput
    End If
    If Trim(strMiddle) = vbNullString Then
        ScanPrefixNumber = "1"
    Else
        ScanPrefixNumber = strMiddle
    End If
End Function

Public Function GetCustomizeDeclare(ByVal strName As String, ByRef bpExist As Boolean) As Double
    On Error Resume Next
    Dim bpFound As Boolean
    Dim lpVariable As Double
    Dim strPrefix As String
    Dim strDeclareName As String
    strPrefix = ScanPrefixNumber(strName, strDeclareName)
    Select Case Trim(UCase(strDeclareName))
        Case Trim(UCase("pi"))
            lpVariable = 3.1415926
            bpFound = True
        Case Trim(UCase("e"))
            lpVariable = 2.718281828459
            bpFound = True
        Case Trim(UCase("true"))
            lpVariable = -1
            bpFound = True
        Case Trim(UCase("false"))
            lpVariable = 0
            bpFound = True
        Case Trim(UCase("K"))
            lpVariable = 0
            bpFound = False
        Case Else
            lpVariable = 0
            bpFound = False
    End Select
    GetCustomizeDeclare = lpVariable * Val(strPrefix)
    bpExist = bpFound
End Function

Public Function ScanPrefix(ByVal strInput As String, ByVal lpEnd As Long, ByRef lpStart As Long) As String
    On Error Resume Next
    Dim lpCurrent As Long
    Dim strIS As String
    Dim strMiddle As String
    Dim lpStartIdle As Long
    Dim lpLength As Long
    Dim lpPosition As Long
    Const strSignature = "+-*/\^()<>=&|!"
    lpPosition = 0
    For lpCurrent = lpEnd To 1 Step -1
        strIS = Mid(strInput, lpCurrent, 1)
        If InStr(1, strSignature, strIS) <> 0 Then
            lpPosition = lpCurrent
            Exit For
        End If
        DoEvents
    Next lpCurrent
    lpStartIdle = lpPosition + 1
    lpStart = lpStartIdle
    lpLength = lpEnd - lpPosition
    strMiddle = Mid(strInput, lpStartIdle, lpLength)
    ScanPrefix = strMiddle
End Function

Public Function ScanSeparateChar(ByVal strInput As String, Optional strChar As String = ",", Optional lpStart As Long = 1) As Long
    On Error Resume Next
    Dim lpCurrent As Long
    Dim lpP1 As Long
    Dim lpP2 As Long
    Dim strIS As String
    Dim lPos As Long
    Dim strPrefix As String
    Dim strPf As String
    Dim lpBegin As Long
    lpP1 = 0
    lpP2 = 0
    lPos = 0
    For lpCurrent = lpStart To (Len(strInput) - Len(strChar) + 1)
        strIS = Mid(strInput, lpCurrent, Len(strChar))
        If Trim(UCase(strIS)) = Trim(UCase("(")) Then
            lpP1 = lpP1 + 1
        End If
        If Trim(UCase(strIS)) = Trim(UCase(")")) Then
            lpP2 = lpP2 + 1
        End If
        If lpP1 = lpP2 Then
            If strIS = strChar Then
                If Len(strChar) = 1 Then
                    If lpCurrent >= 2 Then
                        strPf = Mid(strInput, lpCurrent - 1, 1)
                        If Trim(UCase(strPf)) = Trim(UCase("E")) Then
                            strPrefix = ScanPrefix(strInput, lpCurrent - 1, lpBegin)
                            strPrefix = Left(strPrefix, Len(strPrefix) - 1)
                            If IsNumeric(strPrefix) = True And Trim(strPrefix) <> vbNullString And (strChar = "+" Or strChar = "-") Then
                                GoTo NotThis
                            End If
                        End If
                        If strChar = "-" Then
                            If strPf = "*" Or strPf = "/" Or strPf = "^" Or strPf = "<" Or strPf = ">" Or strPf = "=" Then
                                GoTo NotThis
                            End If
                        End If
                    End If
                End If
                lPos = lpCurrent
                Exit For
NotThis:
            End If
        End If
        DoEvents
    Next lpCurrent
    ScanSeparateChar = lPos
End Function

Public Function OppositePlus(ByVal strInput As String) As String
    On Error Resume Next
    Dim lpCurrent As Long
    Dim lpP1 As Long
    Dim lpP2 As Long
    Dim strIS As String
    Dim strTotal As String
    Dim strPrefix As String
    Dim strPf As String
    Dim lpBegin As Long
    strTotal = vbNullString
    lpP1 = 0
    lpP2 = 0
    For lpCurrent = 1 To Len(strInput)
        strIS = Mid(strInput, lpCurrent, 1)
        If Trim(UCase(strIS)) = Trim(UCase("(")) Then
            lpP1 = lpP1 + 1
        End If
        If Trim(UCase(strIS)) = Trim(UCase(")")) Then
            lpP2 = lpP2 + 1
        End If
        If lpP1 = lpP2 Then
            If Trim(UCase(strIS)) = Trim(UCase("+")) Then
                If lpCurrent >= 2 Then
                    strPf = Mid(strInput, lpCurrent - 1, 1)
                    If Trim(UCase(strPf)) = Trim(UCase("E")) Then
                        strPrefix = ScanPrefix(strInput, lpCurrent - 1, lpBegin)
                        strPrefix = Left(strPrefix, Len(strPrefix) - 1)
                        If IsNumeric(strPrefix) = True And Trim(strPrefix) <> vbNullString Then
                            GoTo JumpSK
                        End If
                    End If
                End If
                strIS = "-"
                GoTo JumpSK
            End If
            If Trim(UCase(strIS)) = Trim(UCase("-")) Then
                If lpCurrent >= 2 Then
                    strPf = Mid(strInput, lpCurrent - 1, 1)
                    If strPf = "*" Or strPf = "/" Or strPf = "^" Or strPf = "<" Or strPf = ">" Or strPf = "=" Then
                        GoTo JumpSK
                    End If
                    If Trim(UCase(strPf)) = Trim(UCase("E")) Then
                        strPrefix = ScanPrefix(strInput, lpCurrent - 1, lpBegin)
                        strPrefix = Left(strPrefix, Len(strPrefix) - 1)
                        If IsNumeric(strPrefix) = True And Trim(strPrefix) <> vbNullString Then
                            GoTo JumpSK
                        End If
                    End If
                End If
                strIS = "+"
                GoTo JumpSK
            End If
JumpSK:
        End If
        strTotal = strTotal & strIS
        DoEvents
    Next lpCurrent
    OppositePlus = strTotal
End Function

Public Function OppositeMultiplication(ByVal strInput As String) As String
    On Error Resume Next
    Dim lpCurrent As Long
    Dim lpP1 As Long
    Dim lpP2 As Long
    Dim strIS As String
    Dim strTotal As String
    strTotal = vbNullString
    lpP1 = 0
    lpP2 = 0
    For lpCurrent = 1 To Len(strInput)
        strIS = Mid(strInput, lpCurrent, 1)
        If Trim(UCase(strIS)) = Trim(UCase("(")) Then
            lpP1 = lpP1 + 1
        End If
        If Trim(UCase(strIS)) = Trim(UCase(")")) Then
            lpP2 = lpP2 + 1
        End If
        If lpP1 = lpP2 Then
            If Trim(UCase(strIS)) = Trim(UCase("*")) Then
                strIS = "/"
                GoTo JumpSK
            End If
            If Trim(UCase(strIS)) = Trim(UCase("/")) Then
                strIS = "*"
                GoTo JumpSK
            End If
JumpSK:
        End If
        strTotal = strTotal & strIS
        DoEvents
    Next lpCurrent
    OppositeMultiplication = strTotal
End Function

Public Function ConvertToRadian(ByVal lpNumber As Double) As Double
    On Error Resume Next
    Dim lpValue As Double
    Const lpPI As Double = 3.1415926
    lpValue = lpNumber * (lpPI / 180)
    ConvertToRadian = lpValue
End Function

Public Function ConvertToDegree(ByVal lpNumber As Double) As Double
    On Error Resume Next
    Dim lpValue As Double
    Const lpPI As Double = 3.1415926
    lpValue = lpNumber * (180 / lpPI)
    ConvertToDegree = lpValue
End Function

Public Function GetFactorial(ByVal lpNumber As Long) As String
    On Error Resume Next
    Dim lpCurrent As Long
    Dim strFinal As String
    strFinal = "1"
    For lpCurrent = lpNumber To 2 Step -1
        strFinal = BigProduct(strFinal, ConvertEPtoNormal(Trim(Str(lpCurrent))))
        DoEvents
    Next lpCurrent
    GetFactorial = Val(strFinal)
End Function

Public Function GetFactorialNegative(ByVal lpNumber As Long) As String
    On Error Resume Next
    Dim lpCurrent As Long
    Dim strFinal As String
    strFinal = "1"
    For lpCurrent = lpNumber To -1
        strFinal = BigProduct(strFinal, ConvertEPtoNormal(Trim(Str(lpCurrent))))
        DoEvents
    Next lpCurrent
    GetFactorialNegative = Val(strFinal)
End Function

Public Function RemoveSpace(ByVal strInput As String) As String
    On Error Resume Next
    Dim strTotal As String
    Dim lpCurrent As Long
    strTotal = vbNullString
    For lpCurrent = 1 To Len(strInput)
        If Mid(strInput, lpCurrent, 1) <> Space(1) Then
            strTotal = strTotal & Mid(strInput, lpCurrent, 1)
        End If
        DoEvents
    Next lpCurrent
    RemoveSpace = strTotal
End Function

Public Function StatisticsIn(ByVal strInput As String, ByVal strStatistics As String) As Long
    On Error Resume Next
    Dim lpCurrent As Long
    Dim strCurrent As String
    Dim lpStatistics As Long
    For lpCurrent = 1 To (Len(strInput) - Len(strStatistics) + 1)
        If Mid(strInput, lpCurrent, Len(strStatistics)) = strStatistics Then
            lpStatistics = lpStatistics + 1
        End If
    Next lpCurrent
    StatisticsIn = lpStatistics
End Function

Public Function ResolveStringCC(ByVal sString As String, ParamArray varReplacements() As Variant) As String
    On Error Resume Next
    Dim intMacro As Integer
    Dim strResString As String
    Dim strMacro As String
    Dim strValue As String
    Dim intPos As Integer
    strResString = sString
    For intMacro = LBound(varReplacements) To UBound(varReplacements) Step 2
        strMacro = varReplacements(intMacro)
        On Error GoTo MismatchedPairs
        strValue = varReplacements(intMacro + 1)
        On Error GoTo 0
        Do
            intPos = InStr(strResString, strMacro)
            If intPos > 0 Then
                strResString = Left$(strResString, intPos - 1) & strValue & Right$(strResString, Len(strResString) - Len(strMacro) - intPos + 1)
            End If
        Loop Until intPos = 0
    Next intMacro
    ResolveStringCC = strResString
    Exit Function
MismatchedPairs:
    Resume Next
End Function

Public Function CalculateString(ByVal strFormula As String, ByRef lpReturn As enuReturns, Optional ByVal lpLevel As Long = 1) As String
    On Error Resume Next
    Dim lpScanEqual As Long
    Dim lpScanRelation As Long
    Dim bpExistCustom As Boolean
    Dim lpCustom As Double
    Dim strInput As String
    Dim lInc1 As Long
    Dim lInc2 As Long
    Dim lpP1 As Long, lpP2 As Long
    Dim strLeft As String
    Dim strRight As String
    Dim ensPWRSub As enuReturns
    Dim lpX As Double
    Dim strPWRReturn As String
    Dim lpPWRInclude As Long
    Dim strPWR1 As String
    Dim strPWR2 As String
    Dim lpCurrent As Long
    Dim lpResults As Double
    Dim lpN As Long
    Dim lpPosition As Long
    Dim lpFinalPos As Long
    Dim strIncludeLeft As String
    Dim strIncludeRight As String
    Dim strReplace As String
    Dim strCallback As String
    Dim bSpecialEnabled As Boolean
    Dim strSpecial As String
    Dim strSpecial2 As String
    Dim strSpecial3 As String
    Dim strSpecial4 As String
    Dim enReturnSub As enuReturns
    Dim lpFunctionSPLength As Long
    Dim strNumberPrefix As String
    Dim lpBegin As Long
    Dim strPrefixNumber As String
    Dim strSuffixIR As String
    Dim lpSuffixMax As Long
    strInput = Trim(strFormula)
    strInput = UCase(strInput)
    strInput = RemoveSpace(strInput)
    strInput = ResolveStringCC(strInput, "<>", "!=")
    strInput = ResolveStringCC(strInput, "||", "|")
    strInput = ResolveStringCC(strInput, "==", "=")
    strInput = ResolveStringCC(strInput, "&&", "&")
    strInput = ResolveStringCC(strInput, "\", "/")
    strInput = ResolveStringCC(strInput, "..", ".")
    strInput = ResolveStringCC(strInput, "++", "+")
    strInput = ResolveStringCC(strInput, "+-", "-")
    strInput = ResolveStringCC(strInput, "--", "-")
    strInput = ResolveStringCC(strInput, "-+", "-")
    strInput = ResolveStringCC(strInput, "**", "*")
    strInput = ResolveStringCC(strInput, "*+", "*")
    strInput = ResolveStringCC(strInput, "//", "/")
    strInput = ResolveStringCC(strInput, "/+", "/")
    strInput = ResolveStringCC(strInput, "^^", "^")
    strInput = ResolveStringCC(strInput, "^+", "^")
    DebuggerSection strInput, lpInput, lpLevel
    If StatisticsIn(strInput, "(") <> StatisticsIn(strInput, ")") Then
        lpReturn = lpSyntaxError
        Exit Function
    End If
    Do
        bSpecialEnabled = False
        lpPosition = InStr(1, strInput, "(")
        If lpPosition = 0 Then
            Exit Do
        End If
        lInc1 = 0
        lInc2 = 0
        For lpN = lpPosition To Len(strInput)
            Select Case Mid(strInput, lpN, 1)
                Case "("
                    lInc1 = lInc1 + 1
                Case ")"
                    lInc2 = lInc2 + 1
            End Select
            If lInc1 = lInc2 And lInc1 <> 0 Then
                Exit For
            End If
            lpFinalPos = lpN
            DoEvents
        Next lpN
        If lpPosition >= 3 Then
            strSpecial4 = Mid(strInput, lpPosition - 2, 2)
        End If
        If lpPosition >= 4 Then
            strSpecial = Mid(strInput, lpPosition - 3, 3)
        End If
        If lpPosition >= 5 Then
            strSpecial2 = Mid(strInput, lpPosition - 4, 4)
        End If
        If lpPosition >= 6 Then
            strSpecial3 = Mid(strInput, lpPosition - 5, 5)
        End If
        strIncludeLeft = Left(strInput, lpPosition - 1)
        If Trim(UCase(strSpecial4)) = Trim(UCase("ln")) Or Trim(UCase(strSpecial4)) = Trim(UCase("sr")) Then
            lpFunctionSPLength = 2
            bSpecialEnabled = True
        End If
        If Trim(UCase(strSpecial)) = Trim(UCase("sqr")) Or Trim(UCase(strSpecial)) = Trim(UCase("abs")) Or _
            Trim(UCase(strSpecial)) = Trim(UCase("cos")) Or Trim(UCase(strSpecial)) = Trim(UCase("exp")) Or _
            Trim(UCase(strSpecial)) = Trim(UCase("log")) Or Trim(UCase(strSpecial)) = Trim(UCase("rnd")) Or _
            Trim(UCase(strSpecial)) = Trim(UCase("sgn")) Or Trim(UCase(strSpecial)) = Trim(UCase("sin")) Or _
            Trim(UCase(strSpecial)) = Trim(UCase("tan")) Or Trim(UCase(strSpecial)) = Trim(UCase("opp")) Or _
            Trim(UCase(strSpecial)) = Trim(UCase("sec")) Or Trim(UCase(strSpecial)) = Trim(UCase("csc")) Or _
            Trim(UCase(strSpecial)) = Trim(UCase("cot")) Or Trim(UCase(strSpecial)) = Trim(UCase("int")) Then
            lpFunctionSPLength = 3
            bSpecialEnabled = True
        End If
        If Trim(UCase(strSpecial2)) = Trim(UCase("hsin")) Or Trim(UCase(strSpecial2)) = Trim(UCase("hcos")) Or _
           Trim(UCase(strSpecial2)) = Trim(UCase("hcsc")) Or Trim(UCase(strSpecial2)) = Trim(UCase("hcot")) Or _
           Trim(UCase(strSpecial2)) = Trim(UCase("hsec")) Or Trim(UCase(strSpecial2)) = Trim(UCase("htan")) Or _
           Trim(UCase(strSpecial2)) = Trim(UCase("icsc")) Or Trim(UCase(strSpecial2)) = Trim(UCase("icos")) Or _
           Trim(UCase(strSpecial2)) = Trim(UCase("icot")) Or Trim(UCase(strSpecial2)) = Trim(UCase("isec")) Or _
           Trim(UCase(strSpecial2)) = Trim(UCase("isin")) Or Trim(UCase(strSpecial2)) = Trim(UCase("itan")) Then
            lpFunctionSPLength = 4
            bSpecialEnabled = True
        End If
        If Trim(UCase(strSpecial3)) = Trim(UCase("ihcos")) Or Trim(UCase(strSpecial3)) = Trim(UCase("ihcsc")) Or _
           Trim(UCase(strSpecial3)) = Trim(UCase("ihcot")) Or Trim(UCase(strSpecial3)) = Trim(UCase("ihsin")) Or _
           Trim(UCase(strSpecial3)) = Trim(UCase("ihsec")) Or Trim(UCase(strSpecial3)) = Trim(UCase("ihtan")) Then
            lpFunctionSPLength = 5
            bSpecialEnabled = True
        End If
        If bSpecialEnabled = True Then
            strIncludeLeft = Left(strInput, lpPosition - (lpFunctionSPLength + 1))
        End If
        If lpPosition >= 2 Then
            strNumberPrefix = ScanPrefix(strIncludeLeft, Len(strIncludeLeft), lpBegin)
            If Trim(strNumberPrefix) <> vbNullString Then
                strIncludeLeft = strIncludeLeft & "*"
            End If
        End If
        strIncludeRight = Right(strInput, Len(strInput) - lpN)
        strSuffixIR = ScanSuffixLetter(strIncludeRight, 1, lpSuffixMax)
        If Trim(strSuffixIR) <> vbNullString Or Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("(")) Then
            strIncludeRight = "*" & strIncludeRight
        End If
        strReplace = Mid(strInput, lpPosition + 1, lpN - lpPosition - 1)
        If Trim(UCase(strSpecial4)) = Trim(UCase("sr")) Then
            lpPWRInclude = ScanSeparateChar(strReplace)
            If lpPWRInclude = 0 Then
                lpReturn = lpSyntaxError
                Exit Function
            End If
            strPWR1 = Left(strReplace, lpPWRInclude - 1)
            strPWR2 = Right(strReplace, Len(strReplace) - lpPWRInclude)
            If IsNumeric(strPWR1) = False Then
                strPWRReturn = CalculateString(strPWR1, ensPWRSub, lpLevel + 1)
                If ensPWRSub <> lpSucceed Then
                    lpReturn = ensPWRSub
                    Exit Function
                End If
                strPWR1 = strPWRReturn
            End If
            If IsNumeric(strPWR2) = False Then
                strPWRReturn = CalculateString(strPWR2, ensPWRSub, lpLevel + 1)
                If ensPWRSub <> lpSucceed Then
                    lpReturn = ensPWRSub
                    Exit Function
                End If
                strPWR2 = strPWRReturn
            End If
            strCallback = Trim(Str(GetRoot(Val(strPWR1), Val(strPWR2))))
            GoTo EndExtract
        End If
        strCallback = CalculateString(strReplace, enReturnSub, lpLevel + 1)
        If enReturnSub <> lpSucceed Then
            lpReturn = enReturnSub
            Exit Function
        End If
        Select Case Trim(UCase(strSpecial3))
            Case Trim(UCase("ihcos"))
                lpX = Val(strCallback)
                lpX = Log(lpX + Sqr(lpX * lpX - 1))
                If bpRadianWay = False Then
                    lpX = ConvertToDegree(lpX)
                End If
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("ihcsc"))
                lpX = Val(strCallback)
                lpX = Log((Sgn(lpX) * Sqr(lpX * lpX + 1) + 1) / lpX)
                If bpRadianWay = False Then
                    lpX = ConvertToDegree(lpX)
                End If
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("ihcot"))
                lpX = Val(strCallback)
                lpX = Log((lpX + 1) / (lpX - 1)) / 2
                If bpRadianWay = False Then
                    lpX = ConvertToDegree(lpX)
                End If
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("ihsin"))
                lpX = Val(strCallback)
                lpX = Log(lpX + Sqr(lpX * lpX + 1))
                If bpRadianWay = False Then
                    lpX = ConvertToDegree(lpX)
                End If
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("ihsec"))
                lpX = Val(strCallback)
                lpX = Log((Sqr(-lpX * lpX + 1) + 1) / lpX)
                If bpRadianWay = False Then
                    lpX = ConvertToDegree(lpX)
                End If
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("ihtan"))
                lpX = Val(strCallback)
                lpX = Log((1 + lpX) / (1 - lpX)) / 2
                If bpRadianWay = False Then
                    lpX = ConvertToDegree(lpX)
                End If
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
        End Select
        Select Case Trim(UCase(strSpecial2))
            Case Trim(UCase("hsin"))
                If bpRadianWay = True Then
                    lpX = Val(strCallback)
                Else
                    lpX = ConvertToRadian(Val(strCallback))
                End If
                lpX = (Exp(lpX) - Exp(-lpX)) / 2
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("hcos"))
                If bpRadianWay = True Then
                    lpX = Val(strCallback)
                Else
                    lpX = ConvertToRadian(Val(strCallback))
                End If
                lpX = (Exp(lpX) + Exp(-lpX)) / 2
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("hcsc"))
                If bpRadianWay = True Then
                    lpX = Val(strCallback)
                Else
                    lpX = ConvertToRadian(Val(strCallback))
                End If
                lpX = 2 / (Exp(lpX) - Exp(-lpX))
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("hcot"))
                If bpRadianWay = True Then
                    lpX = Val(strCallback)
                Else
                    lpX = ConvertToRadian(Val(strCallback))
                End If
                lpX = (Exp(lpX) + Exp(-lpX)) / (Exp(lpX) - Exp(-lpX))
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("hsec"))
                If bpRadianWay = True Then
                    lpX = Val(strCallback)
                Else
                    lpX = ConvertToRadian(Val(strCallback))
                End If
                lpX = 2 / (Exp(lpX) + Exp(-lpX))
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("htan"))
                If bpRadianWay = True Then
                    lpX = Val(strCallback)
                Else
                    lpX = ConvertToRadian(Val(strCallback))
                End If
                lpX = (Exp(lpX) - Exp(-lpX)) / (Exp(lpX) + Exp(-lpX))
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("icsc"))
                lpX = Val(strCallback)
                lpX = Atn(lpX / Sqr(lpX * lpX - 1)) + (Sgn(lpX) - 1) * (2 * Atn(1))
                If bpRadianWay = False Then
                    lpX = ConvertToDegree(lpX)
                End If
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("icos"))
                lpX = Val(strCallback)
                lpX = Atn(-lpX / Sqr(-lpX * lpX + 1)) + 2 * Atn(1)
                If bpRadianWay = False Then
                    lpX = ConvertToDegree(lpX)
                End If
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("icot"))
                lpX = Val(strCallback)
                lpX = Atn(lpX) + 2 * Atn(1)
                If bpRadianWay = False Then
                    lpX = ConvertToDegree(lpX)
                End If
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("isec"))
                lpX = Val(strCallback)
                lpX = Atn(lpX / Sqr(lpX * lpX - 1)) + Sgn((lpX) - 1) * (2 * Atn(1))
                If bpRadianWay = False Then
                    lpX = ConvertToDegree(lpX)
                End If
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("isin"))
                lpX = Val(strCallback)
                lpX = Atn(lpX / Sqr(-lpX * lpX + 1))
                If bpRadianWay = False Then
                    lpX = ConvertToDegree(lpX)
                End If
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("itan"))
                lpX = Val(strCallback)
                lpX = Atn(lpX)
                If bpRadianWay = False Then
                    lpX = ConvertToDegree(lpX)
                End If
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
        End Select
        Select Case Trim(UCase(strSpecial))
            Case Trim(UCase("sqr"))
                If Val(strCallback) < 0 Then
                    lpReturn = lpRunError
                    Exit Function
                End If
                strCallback = Trim(Str(Sqr(Val(strCallback))))
                GoTo EndExtract
            Case Trim(UCase("abs"))
                strCallback = Trim(Str(Abs(Val(strCallback))))
                GoTo EndExtract
            Case Trim(UCase("cos"))
                If bpRadianWay = True Then
                    strCallback = Trim(Str(Cos(Val(strCallback))))
                Else
                    strCallback = Trim(Str(Cos(ConvertToRadian(Val(strCallback)))))
                End If
                GoTo EndExtract
            Case Trim(UCase("exp"))
                strCallback = Trim(Str(Exp(Val(strCallback))))
                GoTo EndExtract
            Case Trim(UCase("log"))
                strCallback = Trim(Str(Log(Val(strCallback)) / Log(lpLogBase)))
                GoTo EndExtract
            Case Trim(UCase("rnd"))
                strCallback = Trim(Str(Rnd(Val(strCallback))))
                GoTo EndExtract
            Case Trim(UCase("sgn"))
                strCallback = Trim(Str(Sgn(Val(strCallback))))
                GoTo EndExtract
            Case Trim(UCase("sin"))
                If bpRadianWay = True Then
                    strCallback = Trim(Str(Sin(Val(strCallback))))
                Else
                    strCallback = Trim(Str(Sin(ConvertToRadian(Val(strCallback)))))
                End If
                GoTo EndExtract
            Case Trim(UCase("opp"))
                strCallback = Trim(Str(-Val(strCallback)))
                GoTo EndExtract
            Case Trim(UCase("tan"))
                If bpRadianWay = True Then
                    strCallback = Trim(Str(Tan(Val(strCallback))))
                Else
                    strCallback = Trim(Str(Tan(ConvertToRadian(Val(strCallback)))))
                End If
                GoTo EndExtract
            Case Trim(UCase("sec"))
                If bpRadianWay = True Then
                    lpX = Val(strCallback)
                Else
                    lpX = ConvertToRadian(Val(strCallback))
                End If
                lpX = 1 / Cos(lpX)
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("csc"))
                If bpRadianWay = True Then
                    lpX = Val(strCallback)
                Else
                    lpX = ConvertToRadian(Val(strCallback))
                End If
                lpX = 1 / Sin(lpX)
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("cot"))
                If bpRadianWay = True Then
                    lpX = Val(strCallback)
                Else
                    lpX = ConvertToRadian(Val(strCallback))
                End If
                lpX = 1 / Tan(lpX)
                strCallback = Trim(Str(lpX))
                GoTo EndExtract
            Case Trim(UCase("int"))
                strCallback = Trim(Str(Int(Val(strCallback))))
                GoTo EndExtract
        End Select
        Select Case Trim(UCase(strSpecial4))
            Case Trim(UCase("ln"))
                strCallback = Trim(Str(Log(Val(strCallback))))
                GoTo EndExtract
        End Select
EndExtract:
        If Right(strIncludeLeft, 1) = "-" And Val(strCallback) < 0 Then
            strCallback = Trim(Str(-Val(strCallback)))
            strIncludeLeft = Left(strIncludeLeft, Len(strIncludeLeft) - 1) & "+"
        End If
        If (Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("+")) Or _
            Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("-")) Or _
            Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("*")) Or _
            Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("/")) Or _
            Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("^")) Or _
            Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("!")) Or _
            Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("=")) Or _
            Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("<")) Or _
            Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase(">")) Or _
            Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("&")) Or _
            Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("|")) Or _
            Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("%"))) And _
            Val(strCallback) < 0 Then
            strCallback = Trim(Str(-Val(strCallback))) & "K"
        End If
        strInput = strIncludeLeft & strCallback & strIncludeRight
        DoEvents
    Loop
    If IsNumeric(strInput) = True Then
        CalculateString = Trim(Str(Val(strInput)))
        lpReturn = lpSucceed
        Exit Function
    End If
    lpPosition = ScanSeparateChar(strInput, "|")
    If lpPosition >= 1 Then
        strLeft = Left(strInput, lpPosition - 1)
        strRight = Right(strInput, Len(strInput) - lpPosition)
        If IsNumeric(strLeft) = False Then
            strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strLeft = strCallback
        End If
        If IsNumeric(strRight) = False Then
            strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strRight = strCallback
        End If
        lpResults = CDbl(Val(strLeft) Or Val(strRight))
        CalculateString = Trim(Str(lpResults))
        lpReturn = lpSucceed
        Exit Function
    End If
    If bpIsMeanXor = True Then
        lpPosition = ScanSeparateChar(strInput, "^")
        If lpPosition >= 1 Then
            strLeft = Left(strInput, lpPosition - 1)
            strRight = Right(strInput, Len(strInput) - lpPosition)
            If IsNumeric(strLeft) = False Then
                strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
                If enReturnSub <> lpSucceed Then
                    lpReturn = enReturnSub
                    Exit Function
                End If
                strLeft = strCallback
            End If
            If IsNumeric(strRight) = False Then
                strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
                If enReturnSub <> lpSucceed Then
                    lpReturn = enReturnSub
                    Exit Function
                End If
                strRight = strCallback
            End If
            lpResults = CDbl(Val(strLeft) Xor Val(strRight))
            CalculateString = Trim(Str(lpResults))
            lpReturn = lpSucceed
            Exit Function
        End If
    End If
    lpPosition = ScanSeparateChar(strInput, "&")
    If lpPosition >= 1 Then
        strLeft = Left(strInput, lpPosition - 1)
        strRight = Right(strInput, Len(strInput) - lpPosition)
        If IsNumeric(strLeft) = False Then
            strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strLeft = strCallback
        End If
        If IsNumeric(strRight) = False Then
            strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strRight = strCallback
        End If
        lpResults = CDbl(Val(strLeft) And Val(strRight))
        CalculateString = Trim(Str(lpResults))
        lpReturn = lpSucceed
        Exit Function
    End If
    lpP1 = 0
    lpP2 = 0
    For lpScanEqual = Len(strInput) To 1 Step -1
        If Mid(strInput, lpScanEqual, 1) = "(" Then
            lpP1 = lpP1 + 1
        End If
        If Mid(strInput, lpScanEqual, 1) = ")" Then
            lpP2 = lpP2 + 1
        End If
        If lpP1 = lpP2 Then
            If (Len(strInput) - lpScanEqual) >= 1 Then
            If Mid(strInput, lpScanEqual, 2) = "!=" Then
                    strLeft = Left(strInput, lpScanEqual - 1)
                    strRight = Right(strInput, Len(strInput) - lpScanEqual - 1)
                    If IsNumeric(strLeft) = False Then
                    strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
                        If enReturnSub <> lpSucceed Then
                            lpReturn = enReturnSub
                        Exit Function
                        End If
                        strLeft = strCallback
                    End If
                    If IsNumeric(strRight) = False Then
                        strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
                        If enReturnSub <> lpSucceed Then
                            lpReturn = enReturnSub
                            Exit Function
                        End If
                        strRight = strCallback
                    End If
                    lpResults = CDbl(Val(strLeft) <> Val(strRight))
                    CalculateString = Trim(Str(lpResults))
                    lpReturn = lpSucceed
                    Exit Function
                End If
            End If
            If Mid(strInput, lpScanEqual, 1) = "=" Then
                strLeft = Left(strInput, lpScanEqual - 1)
                strRight = Right(strInput, Len(strInput) - lpScanEqual)
                If Len(Trim(strLeft)) >= 1 Then
                    If Right(Trim(strLeft), 1) = "!" Or Right(Trim(strLeft), 1) = "<" Or _
                        Right(Trim(strLeft), 1) = ">" Then
                        GoTo NotThisEQ
                    End If
                End If
                If IsNumeric(strLeft) = False Then
                    strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
                    If enReturnSub <> lpSucceed Then
                        lpReturn = enReturnSub
                        Exit Function
                    End If
                    strLeft = strCallback
                End If
                If IsNumeric(strRight) = False Then
                    strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
                    If enReturnSub <> lpSucceed Then
                        lpReturn = enReturnSub
                        Exit Function
                    End If
                    strRight = strCallback
                End If
                lpResults = CDbl(Val(strLeft) = Val(strRight))
                CalculateString = Trim(Str(lpResults))
                lpReturn = lpSucceed
                Exit Function
NotThisEQ:
            End If
        End If
    Next lpScanEqual
    lpP1 = 0
    lpP2 = 0
    For lpScanRelation = Len(strInput) To 1 Step -1
        If Mid(strInput, lpScanRelation, 1) = "(" Then
            lpP1 = lpP1 + 1
        End If
        If Mid(strInput, lpScanRelation, 1) = ")" Then
            lpP2 = lpP2 + 1
        End If
        If lpP1 = lpP2 Then
            If (Len(strInput) - lpScanRelation) >= 1 Then
                If Mid(strInput, lpScanRelation, 2) = "<=" Then
                    strLeft = Left(strInput, lpScanRelation - 1)
                    strRight = Right(strInput, Len(strInput) - lpScanRelation - 1)
                    If IsNumeric(strLeft) = False Then
                        strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
                        If enReturnSub <> lpSucceed Then
                            lpReturn = enReturnSub
                            Exit Function
                        End If
                        strLeft = strCallback
                    End If
                    If IsNumeric(strRight) = False Then
                        strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
                        If enReturnSub <> lpSucceed Then
                            lpReturn = enReturnSub
                            Exit Function
                        End If
                        strRight = strCallback
                    End If
                    lpResults = CDbl(Val(strLeft) <= Val(strRight))
                    CalculateString = Trim(Str(lpResults))
                    lpReturn = lpSucceed
                    Exit Function
                End If
                If Mid(strInput, lpScanRelation, 2) = ">=" Then
                    strLeft = Left(strInput, lpScanRelation - 1)
                    strRight = Right(strInput, Len(strInput) - lpScanRelation - 1)
                    If IsNumeric(strLeft) = False Then
                        strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
                        If enReturnSub <> lpSucceed Then
                            lpReturn = enReturnSub
                            Exit Function
                        End If
                        strLeft = strCallback
                    End If
                    If IsNumeric(strRight) = False Then
                        strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
                        If enReturnSub <> lpSucceed Then
                            lpReturn = enReturnSub
                            Exit Function
                        End If
                        strRight = strCallback
                    End If
                    lpResults = CDbl(Val(strLeft) >= Val(strRight))
                    CalculateString = Trim(Str(lpResults))
                    lpReturn = lpSucceed
                    Exit Function
                End If
            End If
            If Mid(strInput, lpScanRelation, 1) = ">" Then
                strLeft = Left(strInput, lpScanRelation - 1)
                strRight = Right(strInput, Len(strInput) - lpScanRelation)
                If IsNumeric(strLeft) = False Then
                    strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
                    If enReturnSub <> lpSucceed Then
                        lpReturn = enReturnSub
                        Exit Function
                    End If
                    strLeft = strCallback
                End If
                If IsNumeric(strRight) = False Then
                    strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
                    If enReturnSub <> lpSucceed Then
                        lpReturn = enReturnSub
                        Exit Function
                    End If
                    strRight = strCallback
                End If
                lpResults = CDbl(Val(strLeft) > Val(strRight))
                CalculateString = Trim(Str(lpResults))
                lpReturn = lpSucceed
                Exit Function
            End If
            If Mid(strInput, lpScanRelation, 1) = "<" Then
                strLeft = Left(strInput, lpScanRelation - 1)
                strRight = Right(strInput, Len(strInput) - lpScanRelation)
                If IsNumeric(strLeft) = False Then
                    strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
                    If enReturnSub <> lpSucceed Then
                        lpReturn = enReturnSub
                        Exit Function
                    End If
                    strLeft = strCallback
                End If
                If IsNumeric(strRight) = False Then
                    strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
                    If enReturnSub <> lpSucceed Then
                        lpReturn = enReturnSub
                        Exit Function
                    End If
                    strRight = strCallback
                End If
                lpResults = CDbl(Val(strLeft) < Val(strRight))
                CalculateString = Trim(Str(lpResults))
                lpReturn = lpSucceed
                Exit Function
            End If
        End If
    Next lpScanRelation
    lpPosition = ScanSeparateChar(strInput, "+")
    If lpPosition >= 1 Then
        strLeft = Left(strInput, lpPosition - 1)
        strRight = Right(strInput, Len(strInput) - lpPosition)
        If IsNumeric(strLeft) = False Then
            strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strLeft = strCallback
        End If
        If IsNumeric(strRight) = False Then
            strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strRight = strCallback
        End If
        lpResults = Val(strLeft) + Val(strRight)
        CalculateString = Trim(Str(lpResults))
        lpReturn = lpSucceed
        Exit Function
    End If
    lpPosition = ScanSeparateChar(strInput, "-")
    If lpPosition >= 1 Then
        strLeft = Left(strInput, lpPosition - 1)
        strRight = Right(strInput, Len(strInput) - lpPosition)
        If Len(Trim(strLeft)) >= 1 Then
            If Trim(UCase(Right(strLeft, 1))) = Trim(UCase("*")) Or Trim(UCase(Right(strLeft, 1))) = Trim(UCase("/")) Or Trim(UCase(Right(strLeft, 1))) = Trim(UCase("^")) Or _
               Trim(UCase(Right(strLeft, 1))) = Trim(UCase("<")) Or Trim(UCase(Right(strLeft, 1))) = Trim(UCase(">")) Or Trim(UCase(Right(strLeft, 1))) = Trim(UCase("=")) Then
                GoTo NotRemove
            End If
        End If
        If Trim(strLeft) = vbNullString Then
            strLeft = "0"
        Else
            If IsNumeric(strLeft) = False Then
                strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
                If enReturnSub <> lpSucceed Then
                    lpReturn = enReturnSub
                    Exit Function
                End If
                strLeft = strCallback
            End If
        End If
        strRight = OppositePlus(strRight)
        If IsNumeric(strRight) = False Then
            strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strRight = strCallback
        End If
        lpResults = Val(strLeft) - Val(strRight)
        CalculateString = Trim(Str(lpResults))
        lpReturn = lpSucceed
        Exit Function
    End If
NotRemove:
    lpPosition = ScanSeparateChar(strInput, "/")
    If lpPosition >= 1 Then
        strLeft = Left(strInput, lpPosition - 1)
        strRight = Right(strInput, Len(strInput) - lpPosition)
        If IsNumeric(strLeft) = False Then
            strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strLeft = strCallback
        End If
        strRight = OppositeMultiplication(strRight)
        If IsNumeric(strRight) = False Then
            strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strRight = strCallback
        End If
        If Val(strRight) = 0 Then
            lpReturn = lpRunError
            Exit Function
        End If
        lpResults = Val(strLeft) / Val(strRight)
        CalculateString = Trim(Str(lpResults))
        lpReturn = lpSucceed
        Exit Function
    End If
    lpPosition = ScanSeparateChar(strInput, "*")
    If lpPosition >= 1 Then
        strLeft = Left(strInput, lpPosition - 1)
        strRight = Right(strInput, Len(strInput) - lpPosition)
        If IsNumeric(strLeft) = False Then
            strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strLeft = strCallback
        End If
        If IsNumeric(strRight) = False Then
            strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strRight = strCallback
        End If
        lpResults = Val(strLeft) * Val(strRight)
        CalculateString = Trim(Str(lpResults))
        lpReturn = lpSucceed
        Exit Function
    End If
    If bpIsMeanXor = False Then
        lpPosition = ScanSeparateChar(strInput, "^")
        If lpPosition >= 1 Then
            strLeft = Left(strInput, lpPosition - 1)
            strRight = Right(strInput, Len(strInput) - lpPosition)
            If IsNumeric(strLeft) = False Then
                strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
                If enReturnSub <> lpSucceed Then
                    lpReturn = enReturnSub
                    Exit Function
                End If
                strLeft = strCallback
            End If
            If IsNumeric(strRight) = False Then
                strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
                If enReturnSub <> lpSucceed Then
                    lpReturn = enReturnSub
                    Exit Function
                End If
                strRight = strCallback
            End If
            lpResults = Val(strLeft) ^ Val(strRight)
            CalculateString = Trim(Str(lpResults))
            lpReturn = lpSucceed
            Exit Function
        End If
    End If
    If Trim(UCase(Right(strInput, 1))) = Trim(UCase("!")) Then
        strLeft = Left(strInput, Len(strInput) - 1)
        If IsNumeric(strLeft) = False Then
            strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strLeft = strCallback
        End If
        If Val(strLeft) < 0 Then
            CalculateString = GetFactorialNegative(Val(strLeft))
        Else
            CalculateString = GetFactorial(Val(strLeft))
        End If
        lpReturn = lpSucceed
        Exit Function
    End If
    If Trim(UCase(Right(strInput, 1))) = Trim(UCase("%")) Then
        strLeft = Left(strInput, Len(strInput) - 1)
        If IsNumeric(strLeft) = False Then
            strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strLeft = strCallback
        End If
        CalculateString = Trim(Str(Val(strLeft) / 100))
        lpReturn = lpSucceed
        Exit Function
    End If
    lpCustom = GetCustomizeDeclare(strInput, bpExistCustom)
    If bpExistCustom = True Then
        CalculateString = Trim(Str(lpCustom))
        lpReturn = lpSucceed
        Exit Function
    End If
    If Trim(UCase(Right(strInput, 1))) = Trim(UCase("K")) Then
        strLeft = Left(strInput, Len(strInput) - 1)
        If IsNumeric(strLeft) = False Then
            strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
            If enReturnSub <> lpSucceed Then
                lpReturn = enReturnSub
                Exit Function
            End If
            strLeft = strCallback
        End If
        CalculateString = Trim(Str(-Val(strLeft)))
        lpReturn = lpSucceed
        Exit Function
    End If
    If Trim(strInput) = vbNullString Then
        CalculateString = "0"
        lpReturn = lpSucceed
        Exit Function
    End If
    lpReturn = lpSyntaxError
End Function

Public Function ConvertEPtoNormal(ByVal strInput As String) As String
    On Error Resume Next
    Dim strIS As String
    Dim lpStart As Long
    Dim strL As String
    Dim strR As String
    Dim bpOpposite As Boolean
    bpOpposite = False
    strIS = Trim(UCase(strInput))
    lpStart = InStr(1, strIS, "E+")
    If lpStart = 0 Then
        lpStart = InStr(1, strIS, "E-")
        bpOpposite = True
    End If
    If lpStart = 0 Then
        ConvertEPtoNormal = strIS
    Else
        strL = Left(strIS, lpStart - 1)
        strR = Right(strIS, Len(strIS) - (lpStart + 1))
        If IsNumeric(strL) = False Then
            strL = "1"
        End If
        If IsNumeric(strR) = False Then
            strR = "1"
        End If
        If bpOpposite = False Then
            ConvertEPtoNormal = BigProduct(strL, "1" & String(Val(strR), "0"))
        Else
            ConvertEPtoNormal = BigProduct(strL, "0." & String(Val(strR) - 1, "0") & "1")
        End If
    End If
End Function

Public Function BigAdd(ByVal a, ByVal B) As String
    On Error Resume Next
    Dim SA As Boolean, SB As Boolean, S As String
    If Left(a, 1) = "-" Then
        SA = True
    End If
    If Left(B, 1) = "-" Then
        SB = True
    End If
    If Not SA And Not SB Then
        S = xBigAdd(a, B)
    ElseIf SA And Not SB Then
        S = xBigSubtract(B, Right(a, Len(a) - 1))
    ElseIf Not SA And SB Then
        S = xBigSubtract(a, Right(B, Len(B) - 1))
    ElseIf SA And SB Then
        S = xBigAdd(Right(a, Len(a) - 1), Right(B, Len(B) - 1))
        If Left(S, 1) = "-" Then
            S = Right(S, Len(S) - 1)
        Else
            S = "-" & S
        End If
    End If
    BigAdd = S
End Function

Public Function BigSubtract(ByVal a, ByVal B) As String
    On Error Resume Next
    Dim SA As Boolean, SB As Boolean, S As String
    If Left(a, 1) = "-" Then
        SA = True
    End If
    If Left(B, 1) = "-" Then
        SB = True
    End If
    If Not SA And Not SB Then
        S = xBigSubtract(a, B)
    ElseIf SA And Not SB Then
        S = "-" & xBigAdd(Right(a, Len(a) - 1), B)
    ElseIf Not SA And SB Then
        S = xBigAdd(a, Right(B, Len(B) - 1))
    ElseIf SA And SB Then
        S = xBigSubtract(Right(B, Len(B) - 1), Right(a, Len(a) - 1))
    End If
    BigSubtract = S
End Function

Public Function BigProduct(ByVal a, ByVal B) As String
    On Error Resume Next
    Dim SA As Boolean, SB As Boolean, S As String
    If Left(a, 1) = "-" Then
        SA = True
    End If
    If Left(B, 1) = "-" Then
        SB = True
    End If
    If Not SA And Not SB Then
        S = xBigProduct(a, B)
    ElseIf SA And Not SB Then
        S = "-" & xBigProduct(Right(a, Len(a) - 1), B)
    ElseIf Not SA And SB Then
        S = "-" & xBigProduct(a, Right(B, Len(B) - 1))
    ElseIf SA And SB Then
        S = xBigProduct(Right(B, Len(B) - 1), Right(a, Len(a) - 1))
    End If
    BigProduct = S
End Function

Public Function BigDivide(ByVal a, ByVal B, ByVal C) As String
    On Error Resume Next
    Dim SA As Boolean, SB As Boolean, S As String
    If Left(a, 1) = "-" Then
        SA = True
    End If
    If Left(B, 1) = "-" Then
        SB = True
    End If
    If Not SA And Not SB Then
        S = xBigDivide(a, B, C)
    ElseIf SA And Not SB Then
        S = "-" & xBigDivide(Right(a, Len(a) - 1), B, C)
    ElseIf Not SA And SB Then
        S = "-" & xBigDivide(a, Right(B, Len(B) - 1), C)
    ElseIf SA And SB Then
        S = xBigDivide(Right(B, Len(B) - 1), Right(a, Len(a) - 1), C)
    End If
    BigDivide = S
End Function

Public Function xBigAdd(ByVal a, ByVal B) As String
    On Error Resume Next
    Dim PA As Long, PB As Long, LA As Long, LB As Long, L As Long, C As Long, f As Long, FP As Long
    Dim IA As String, IB As String, FA As String, FB As String, RA As String, RB As String, S As String
    Dim i As Long, LI As Long, LF As Long
    PA = InStr(a, ".")
    PB = InStr(B, ".")
    If PB > PA Then
        LI = PB
    Else
        LI = PA
    End If
    If Len(B) - PB > Len(a) - PA Then
        LF = Len(B) - PB
    Else
        LF = Len(a) - PA
    End If
    If LI + LF < 15 Then
        xBigAdd = Val(a) + Val(B)
        Exit Function
    End If
    If PA > 0 Then
        IA = Left(a, PA - 1)
        FA = Right(a, Len(a) - PA)
    Else
        IA = a
        FA = ""
    End If
    If PB > 0 Then
        IB = Left(B, PB - 1)
        FB = Right(B, Len(B) - PB)
    Else
        IB = B
        FB = ""
    End If
    If Len(IA) = 0 Then
        IA = "0"
    End If
    If Len(IB) = 0 Then
        IB = "0"
    End If
    LA = Len(FA)
    LB = Len(FB)
    If LA > LB Then
        FB = FB & String(LA - LB, "0")
        FP = LA
    ElseIf LB > LA Then
        FA = FA & String(LB - LA, "0")
        FP = LB
    End If
    FP = Len(FA)
    RA = StrReverse(IA & FA)
    RB = StrReverse(IB & FB)
    LA = Len(RA)
    LB = Len(RB)
    If LA < LB Then L = LB Else L = LA
    S = ""
    f = 0
    For i = 1 To L
        C = Val(Mid(RA, i, 1)) + Val(Mid(RB, i, 1)) + f
        f = C \ 10
        S = (C Mod 10) & S
    Next i
    If f > 0 Then S = f & S
    L = Len(S)
    S = Left(S, L - FP) & "." & Right(S, FP)
    S = Replace(RTrim(Replace(S, "0", " ")), " ", "0")
    If Right(S, 1) = "." Then S = Left(S, Len(S) - 1)
    xBigAdd = S
End Function

Public Function xBigSubtract(ByVal a, ByVal B) As String
    On Error Resume Next
    Dim PA As Long, PB As Long, LA As Long, LB As Long, L As Long, C As Long, f As Long, FP As Long
    Dim IA As String, IB As String, FA As String, FB As String, RA As String, RB As String, S As String
    Dim Sign As String, T As String, LI As Long, LF As Long
    Dim i As Long
    PA = InStr(a, ".")
    PB = InStr(B, ".")
    If PB > PA Then
        LI = PB
    Else
        LI = PA
    End If
    If Len(B) - PB > Len(a) - PA Then
        LF = Len(B) - PB
    Else
        LF = Len(a) - PA
    End If
    If LI + LF < 16 Then
        xBigSubtract = Val(a) - Val(B)
        Exit Function
    End If
    If PA > 0 Then
        IA = Left(a, PA - 1)
        FA = Right(a, Len(a) - PA)
    Else
        IA = a
        FA = ""
    End If
    If PB > 0 Then
        IB = Left(B, PB - 1)
        FB = Right(B, Len(B) - PB)
    Else
        IB = B
        FB = ""
    End If
    If Len(IA) = 0 Then IA = "0"
    If Len(IB) = 0 Then IB = "0"
    LA = Len(FA)
    LB = Len(FB)
    If LA > LB Then
        FB = FB & String(LA - LB, "0")
        FP = LA
    ElseIf LB > LA Then
        FA = FA & String(LB - LA, "0")
        FP = LB
    End If
    FP = Len(FA)
    RA = IA & FA
    RB = IB & FB
    LA = Len(RA)
    LB = Len(RB)
    Sign = ""
    If LA < LB Or (LA = LB And RA < RB) Then
        T = RA
        RA = RB
        RB = T
        Sign = "-"
    End If
    LA = Len(RA)
    RA = StrReverse(RA)
    RB = StrReverse(RB)
    S = ""
    f = 0
    For i = 1 To LA
        C = Val(Mid(RA, i, 1)) - Val(Mid(RB, i, 1)) + f
        If C < 0 Then
            f = -1
            C = C + 10
        Else
            f = 0
        End If
        S = C & S
    Next i
    L = Len(S)
    S = Left(S, L - FP) & "." & Right(S, FP)
    S = Replace(Trim(Replace(S, "0", " ")), " ", "0")
    If Left(S, 1) = "." Then
        S = "0" & S
    End If
    If Right(S, 1) = "." Then
        S = Left(S, Len(S) - 1)
    End If
    S = Sign & S
    xBigSubtract = S
End Function

Public Function xBigProduct(ByVal a, ByVal B) As String
    On Error Resume Next
    Dim L As Long, LA As Long, LB As Long, PA As Long, PB As Long, FP As Long, CA As Long, CB As Long, C As Long, f As Long
    Dim RA As String, RB As String, S As String, Sj As String
    Dim i As Long, J As Long
    PA = InStr(a, ".")
    PB = InStr(B, ".")
    If PA > 0 Then
        LA = Len(a) - PA
    Else
        LA = 0
    End If
    If PB > 0 Then
        LB = Len(B) - PB
    Else
        LB = 0
    End If
    FP = LA + LB
    RA = StrReverse(Replace(a, ".", ""))
    RB = StrReverse(Replace(B, ".", ""))
    LA = Len(RA)
    LB = Len(RB)
    If LA + LB < 16 Then
        xBigProduct = Val(a) * Val(B)
        Exit Function
    End If
    S = ""
    For i = 1 To LB
        CB = Val(Mid(RB, i, 1))
        Sj = ""
        f = 0
        For J = 1 To LA
            C = CB * Val(Mid(RA, J, 1)) + f
            f = C \ 10
            Sj = (C Mod 10) & Sj
        Next J
        If f > 0 Then Sj = f & Sj
        S = BigAdd(S, Sj & String(i - 1, "0"))
    Next i
    L = Len(S)
    S = Left(S, L - FP) & "." & Right(S, FP)
    S = Replace(RTrim(Replace(S, "0", " ")), " ", "0")
    If Right(S, 1) = "." Then
        S = Left(S, Len(S) - 1)
    End If
    If S = "" Then
        S = "0"
    End If
    xBigProduct = S
End Function

Public Function xBigDivide(ByVal a, ByVal B, ByVal C) As String
    On Error Resume Next
    Dim S As String, PreA As String, RA As String, RB As String
    Dim L As Long, LA As Long, LB As Long, cmp As Long, D As Long, PA As Long, PB As Long, FP As Long
    Dim i As Long, J As Long
    If Val(B) = 0 Then
        xBigDivide = "0"
        Exit Function
    End If
    RA = a
    RB = B
    PA = InStr(a, ".")
    PB = InStr(B, ".")
    If PA > 0 Then
        LA = Len(a) - PA
    Else
        LA = 0
    End If
    If PB > 0 Then
        LB = Len(B) - PB
    Else
        LB = 0
    End If
    FP = LA - LB
    a = Replace(LTrim(Replace(Replace(a, ".", ""), "0", " ")), " ", "0")
    B = Replace(LTrim(Replace(Replace(B, ".", ""), "0", " ")), " ", "0")
    C = Val(C)
    FP = C - FP + 1
    If Abs(Len(a) - Len(B) + 1 + FP) < 17 And FP < 17 And Len(a) < 16 And Len(B) < 16 Then
        xBigDivide = Round(Val(RA) / Val(RB), C)
        Exit Function
    End If
    If FP > 0 Then
        a = a & String(FP, "0")
    End If
    LA = Len(a)
    LB = Len(B)
    If LA > LB Then
        B = B & String(LA - LB, "0")
    End If
    L = LA - LB + 1
    For i = 1 To L
        D = -1
        Do
            D = D + 1
            PreA = a
            a = xBigSubtract(a, B)
        Loop Until Left(a, 1) = "-"
        a = PreA
        B = Left(B, Len(B) - 1)
        S = S & D
    Next i
    If S = "" Then
        S = "0"
    End If
    If FP < 0 Then
        S = Left(S, Len(S) + FP)
    End If
    If Right(S, 1) >= "5" Then
        S = xBigAdd(Left(S, Len(S) - 1), "1")
    Else
        S = Left(S, Len(S) - 1)
    End If
    If C > 0 Then
        If Len(S) <= C Then
            S = String(C - Len(S) + 1, "0") & S
        End If
        S = Left(S, Len(S) - C) & "." & Right(S, C)
        S = Replace(RTrim(Replace(S, "0", " ")), " ", "0")
        If Right(S, 1) = "." Then
            S = Left(S, Len(S) - 1)
        End If
    End If
    S = Replace(LTrim(Replace(S, "0", " ")), " ", "0")
    If S = "" Or Left(S, 1) = "." Then
        S = "0" & S
    End If
    xBigDivide = S
End Function
